Pascal Super Library/Pascal Super Library (CW International)(1997).bin/DELPHI32/COMPNENT/SAWIN95/ANIMCTL.PAS

Pascal/Delphi Source File | 1996-10-18 | 5KB | 224 lines

unit AnimCtl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, CommCtrl;

type
  TAnimation = class(TWinControl)
  private
    FAutoPlay   : Boolean;
    FAVIFile    : String;
    FCentered   : Boolean;
    FFrom       : Integer;
    FOpen       : Boolean;
    FRepeat     : Integer;
    FTo         : Integer;
    FTransparent: Boolean;

    FOnStart    : TNotifyEvent;
    FOnStop     : TNotifyEvent;
    procedure SetAVIFile(Value: String);
    procedure SetAutoPlay(Value: Boolean);
    procedure SetCentered(Value: Boolean);
    procedure SetTransparent(Value: Boolean);
  protected
    procedure Animate_Open(szName : PChar);
    procedure Animate_Close;
    procedure Animate_Play(FromFrame, ToFrame, RepeatCount: Integer);
    procedure Animate_Stop;
    procedure Animate_Seek(Frame : Integer);
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure Play;
    procedure Stop;
  published
    property Align;
    property AutoPlay: Boolean read FAutoPlay write SetAutoPlay default False;
    property AVIFile: String read FAVIFile write SetAVIFile;
    property Centered: Boolean read FCentered write SetCentered default True;
    property Color;
    property Enabled;
    property FromFrame: Integer read FFrom write FFrom default 0;
    property ToFrame: Integer read FTo write FTo default -1;
    property Hint;
    property ParentColor;
    property ParentShowHint;
    property PopupMenu;
    property RepeatCount: Integer read FRepeat write FRepeat default -1;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Transparent: Boolean read FTransparent write SetTransparent default True;
    property Visible;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    property OnStart: TNotifyEvent read FOnStart write FOnStart;
    property OnStop: TNotifyEvent read FOnStop write FOnStop;
  end;

{$R ANIMCTL.RES}

implementation

constructor TAnimation.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FTransparent := True;
  FAutoPlay := False;
  FCentered := True;
  FFrom := 0;
  FTo := -1;
  FRepeat := -1;
end;

destructor TAnimation.Destroy;
begin
  Close;
  inherited Destroy;
end;

procedure TAnimation.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  CreateSubClass(Params, ANIMATE_CLASS);
  if AutoPlay then Params.Style := Params.Style or ACS_AUTOPLAY;
  if Centered then Params.Style := Params.Style or ACS_CENTER;
  if Transparent then Params.Style := Params.Style or ACS_TRANSPARENT;
end;

procedure TAnimation.CreateWnd;
begin
  inherited CreateWnd;
  if AVIFile<>'' then Open;
end;

procedure TAnimation.CNCommand(var Message: TWMCommand);
begin
  case Message.NotifyCode of
    ACN_START: if Assigned(FOnStart) then FOnStart(Self);
    ACN_STOP : if Assigned(FOnStop) then FOnStop(Self);
  end;
end;

procedure TAnimation.CMColorChanged(var Message: TMessage);
begin
  inherited;
  RecreateWnd;
end;

procedure TAnimation.SetAutoPlay(Value: Boolean);
begin
  if FAutoPlay<>Value then
   begin
     FAutoPlay := Value;
     RecreateWnd;
   end;
end;

procedure TAnimation.SetCentered(Value: Boolean);
begin
  if FCentered<>Value then
   begin
     FCentered := Value;
     RecreateWnd;
   end;
end;

procedure TAnimation.SetAVIFile(Value : String);
begin
  if FAVIFile<>Value then
   begin
     FAviFile := Value;
     Close;
     Repaint;
     Open;
   end;
end;

procedure TAnimation.Animate_Play(FromFrame, ToFrame, RepeatCount: Integer);
begin
  if HandleAllocated then SendMessage(Handle, ACM_PLAY, WParam(RepeatCount),  LParam(MakeLong(FromFrame, ToFrame)));
end;

procedure TAnimation.Animate_Stop;
begin
  if HandleAllocated then SendMessage(Handle, ACM_STOP, 0, 0);
end;

procedure TAnimation.Animate_Seek(Frame : Integer);
begin
  Animate_Play(Frame, Frame, 1);
end;

procedure TAnimation.Animate_Close;
begin
  Animate_Open(nil);
end;

procedure TAnimation.Animate_Open(szName : PChar);
begin
  if HandleAllocated then SendMessage(Handle, ACM_OPEN, 0, LParam(szName));
end;

procedure TAnimation.SetTransparent(Value: Boolean);
begin
  if FTransparent<>Value then
   begin
     FTransparent := Value;
     RecreateWnd;
   end;
end;

procedure TAnimation.Play;
begin
  Animate_Play(FromFrame, ToFrame, RepeatCount);
end;

procedure TAnimation.Stop;
begin
  Animate_Stop;
end;

procedure TAnimation.Open;
var
  pFile : PChar;
begin
  try
    Animate_Open(MakeIntResource(StrToInt(AVIFile)));
  except
    if Length(AVIFile)>0 then
     begin
       pFile := StrAlloc(Length(AVIFile)+1);
       try
         StrPCopy(pFile, AVIFile);
         Animate_Open(pFile);
       finally
         StrDispose(pFile);
       end;
     end;
  end;
end;

procedure TAnimation.Close;
begin
  Animate_Close;
end;

end.